module FdBuildin where

import FdType
import FdArray
import FdString
import FdHash
import FdUtil
import FdHelper

import Data.List
import Monad
import Control.Monad.Error

--all types have to be [Val] -> Fineday Val
--


-- basic
-- + - * / %
arithmetic f [Nil, b]             = arithmetic f [Number 0.0, b]
arithmetic f [a, Nil]             = arithmetic f [a, Number 0.0]
arithmetic f [Number a, Number b] = return $ Number $ f a b
arithmetic f [_, _]               = throwError $ TypeErr $ "Not number"
arithmetic f paras                = throwError $ ParamErr (length paras) 2

fd_add [a1@(Array _),  a2@(Array _)]     = fd_concat_array  [a1, a2]
fd_add [s1@(String _), s2@(String _)]    = fd_concat_string [s1, s2]
fd_add paras = arithmetic (+) paras

fd_sub = arithmetic (-)

fd_mul = arithmetic (*)

fd_div [_, Number 0] = throwError $ Default $ "Divided by 0"
fd_div paras         = arithmetic (/) paras

fd_mod [_, Number 0]        = throwError $ Default $ "Mod by 0"
fd_mod paras                = arithmetic mod' paras
    where mod' a b = fromInteger $ mod (round a) (round b)

fd_neg [Number a] = return $ Number $ 0 - a


-- && ||
fd_and [a,b] = do {
	result <- mapM isNotFalse [a,b];
	return $ Bool $ and $ result;
}

fd_or  [a,b] = do {
	result <- mapM isNotFalse [a,b];
	return $ Bool $ or $ result;
}

-- !
fd_not [a] = do {
	result <- isNotFalse a;
   	return $ Bool $ not $ result;
}

-- < >
fd_lt [Number a,Number b]    = return $ Bool $ a < b
fd_lt _                      = throwError $ TypeErr $ "cannot be compared"

fd_gt [Number a,Number b]    = return $ Bool $ a > b
fd_gt _                      = throwError $ TypeErr $ "cannot be compared"

-- <= >=
fd_lteq [Number a,Number b]  = return $ Bool $ a <= b
fd_lteq _                    = throwError $ TypeErr $ "cannot be compared"

fd_gteq [Number a,Number b]  = return $ Bool $ a >= b
fd_gteq _                    = throwError $ TypeErr $ "cannot be compared"

-- ==
fd_equal [a, b]              = return $ Bool $ (a==b)
fd_equal _                   = return $ Bool $ False

fd_not_equal [a,b] = do {
	(Bool r) <- fd_equal (a:b:[]);
	return $ Bool $ not r;
}

--- <<
fd_append (Array  arrRef: val: [])      = fmap Array $ appendArrayItem arrRef val
fd_append (String strRef: String s: []) = str_to_char s >>= \c -> fmap String $ appendArrayItem strRef c
fd_append (val:_)                       = throwError $ TypeErr $ (typeOf val)++" cannot be appended"

-----------------------------------------------------

--type
fd_typeof [a] = s_ $ typeOf a

--io
-- fd_puts and fd_gets
fd_puts [a] = do {
	io $ putStrLn $ show $ a;
	return $ a;
}

fd_gets [] = do {
	str <- io getLine;
	fd_new_string $ str;
}

--a list of "build-in" functions
primitives :: [(Id, Func)]
primitives = [
	--prefix op
	("pre_-",	(fd_neg)),			
	("pre_!",	(fd_not)),
	--math op
	("+",		(fd_add)),
	("-",		(fd_sub)),
	("*",		(fd_mul)),
	("/",		(fd_div)),
	("%",       (fd_mod)),
	--logic op
	(">",       (fd_gt)),
	("<",       (fd_lt)),
	(">=",      (fd_gteq)),
	("<=",      (fd_lteq)),
	("==",		(fd_equal)),		
	("!=",		(fd_not_equal)),
	("&&",		(fd_and)),
	("||",		(fd_or)),
	--type
	("typeof",  (fd_typeof)),
	--simple io
	("puts",	(fd_puts)),
	("gets",	(fd_gets)),
	--array
	("<<",      (fd_append))]



